home *** CD-ROM | disk | FTP | other *** search
/ Megarom / Megarom Macintosh CD Software (Quantum Leap)(1992).iso / COMPRESS / Disk Application ƒ / Disks.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1987-06-12  |  3.6 KB  |  127 lines  |  [TEXT/MSWD]
  1. PROGRAM Disk;
  2.     CONST
  3.         diskSize = 797696;
  4.         MaxFiles = 750;
  5.         diskMax = 150;
  6.         tab = '    ';
  7.     VAR
  8.         fileList : Text;
  9.         i, j, size, filecount, usedCount, filesUsed : Integer;
  10.         inDisk, Wasted : LongInt;
  11.         aRect : Rect;
  12.         foundOne : Boolean;
  13.         fname : STRING;
  14.         Names : ARRAY[1..MaxFiles] OF STRING[32];
  15.         Sizes : ARRAY[1..MaxFiles] OF LongInt;
  16.         Used : ARRAY[1..MaxFiles] OF Boolean;
  17.         thisDisk : ARRAY[1..diskMax] OF 0..MaxFiles;
  18.  
  19. BEGIN
  20.     SetRect(aRect, 10, 50, 500, 200);
  21.     SetTextRect(aRect);
  22.     fname := OldFileName('Pick the text file to read');
  23.     IF fname = '' THEN
  24.         ExitToShell;
  25.     reset(fileList, fname);
  26.     fileCount := 0;
  27.     WHILE NOT EOF(fileList) AND (fileCount < maxFiles) DO
  28.         BEGIN
  29.             fileCount := fileCount + 1;
  30.             readln(fileList, fname);
  31.             Names[maxFiles] := copy(fname, 1, pos(tab, fname) - 1);
  32.             delete(fname, 1, pos(tab, fname));
  33.             readString(fname, Sizes[maxFiles]);
  34.             Used[fileCount] := False;
  35.             IF Sizes[maxFiles] > diskSize THEN
  36.                 BEGIN
  37.                     ShowText;
  38.                     writeln(Names[maxFiles], ' is too big!  It will be ignored.');
  39.                     fileCount := fileCount - 1;
  40.                 END
  41.             ELSE        { Insert in decending size order }
  42.                 BEGIN
  43.                     j := 0;
  44.                     REPEAT
  45.                         j := j + 1;
  46.                     UNTIL (Sizes[j] < Sizes[maxFiles]) OR (j >= fileCount);
  47.         { move j to fileCount-1 down }
  48.                     FOR i := fileCount - 1 DOWNTO j DO
  49.                         BEGIN
  50.                             Sizes[i + 1] := Sizes[i];
  51.                             Names[i + 1] := Names[i];
  52.                         END;
  53.                     Names[j] := Names[maxFiles];
  54.                     Sizes[j] := Sizes[maxFiles];
  55.                 END;
  56.             IF (fileCount = maxFiles) AND NOT EOF(fileList) THEN
  57.                 BEGIN
  58.                     ShowText;
  59.                     Writeln('Too many files!  Current limit is ', maxFiles : 1, '.');
  60.                     Writeln('I will only process that many.');
  61.                 END;
  62.         END;
  63.     Close(fileList);
  64.     fname := NewFileName('Save as…', 'Output');
  65.     IF fname = '' THEN
  66.         ExitToShell;
  67.     rewrite(fileList, fname);
  68.     usedCount := 0;
  69.     filesUsed := 0;
  70.     Wasted := 0;
  71.     WHILE filesUsed < fileCount DO
  72.         BEGIN
  73.     { Fill another disk }
  74.             usedCount := usedCount + 1;
  75.             inDisk := 0;
  76.             j := 0;
  77.             FOR i := 1 TO diskMax DO
  78.                 thisDisk[i] := 0;
  79.             FoundOne := True;
  80.             WHILE (inDisk < diskSize) AND foundOne DO
  81.                 BEGIN
  82.         { Find largest file that fits from the sorted file }
  83.                     FoundOne := false;
  84.                     i := 0;
  85.                     WHILE (i < fileCount) DO
  86.                         BEGIN
  87.                             i := i + 1;
  88.                             IF NOT Used[i] AND (Sizes[i] + inDisk < diskSize) THEN
  89.                                 BEGIN
  90.                 { Add a found file to the list }
  91.                                     j := j + 1;
  92.                                     filesUsed := filesUsed + 1;
  93.                                     Used[i] := True;
  94.                                     thisDisk[j] := i;
  95.                                     foundOne := True;
  96.                                     inDisk := inDisk + Sizes[i];
  97.                                 END;
  98.                         END;
  99.                 END;
  100.             Writeln(fileList);
  101.             Writeln(fileList, '   Disk #', usedCount : 1);
  102.             FOR i := 1 TO j DO
  103.                 Writeln(fileList, Names[thisDisk[i]], tab, Sizes[thisDisk[i]]);
  104.             Wasted := Wasted + diskSize - inDisk;
  105.             Writeln(fileList, 'Free space', tab, diskSize - inDisk);
  106.         END;
  107.     Wasted := Wasted - diskSize + inDisk;
  108.  
  109.     Writeln(fileList);
  110.     Writeln(fileList, usedCount : 1, ' disks used for ', fileCount : 1, ' files.');
  111.     Writeln(fileList, Wasted : 1, ' bytes (', Wasted / 1024 : 1 : 1, 'K) of wasted space on all filled disks.');
  112.     Writeln(fileList, diskSize - inDisk : 1, ' bytes (', (diskSize - inDisk) / 1024 : 1 : 1, 'K) of empty space on last disk.');
  113.     Close(fileList);
  114.  
  115.     ShowText;
  116.     Writeln;
  117.     Writeln(usedCount : 1, ' disks used for ', fileCount : 1, ' files.');
  118.     Writeln(Wasted : 1, ' bytes (', Wasted / 1024 : 1 : 1, 'K) of wasted space on all filled disks.');
  119.     Writeln(diskSize - inDisk : 1, ' bytes (', (diskSize - inDisk) / 1024 : 1 : 1, 'K) of empty space on last disk.');
  120.     Writeln;
  121.     Writeln('Press mouse button to continue');
  122.     WHILE NOT Button DO
  123.         ;
  124.     WHILE Button DO
  125.         ;
  126. END.
  127.